home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / CHKSER.M < prev    next >
Encoding:
Text File  |  1989-03-10  |  7.1 KB  |  230 lines
  1. MODULE CheckSerial;
  2.  
  3. (*    =======================================
  4.        Vertraulich! Keinesfalls weitergeben!
  5.       =======================================
  6.    
  7.       Seriennummern im Compiler überprüfen
  8.         
  9.       15.12.87  jm   /1.0/  lauffähige Version
  10.                             (meldet nur, wenn ok; keine weitere Analyse)
  11.      
  12. *)
  13.  
  14. FROM Files   IMPORT File, Open, Create, Close, Remove, State,
  15.                     Access, ReplaceMode;
  16. FROM Binary  IMPORT SeekMode, Seek, ReadBytes, ReadWord, WriteWord, FileSize;
  17. FROM Paths   IMPORT PathList, StdPaths, SearchFile, ListPos;
  18. FROM InOut   IMPORT WriteString, WriteLn, Read, WriteCard, ReadCard, WriteHex;
  19. FROM Storage IMPORT ALLOCATE;
  20. FROM Strings IMPORT Concat;
  21. FROM StrConv IMPORT CardToStr;
  22. FROM SYSTEM  IMPORT ADDRESS;
  23. FROM PrgCtrl IMPORT TermProcess;
  24.  
  25.  
  26. CONST   compname = 'A:\M2.MOD';          (* Name des Codefiles *)
  27.           NrKeys = 2;                 (* Anzahl verschiedener Schlüssel *)
  28.         maxCount = 10;                (* max. Anzahl Referenzen pro Nummer *)
  29.  
  30. TYPE     PosList = ARRAY [1..maxCount] OF LONGCARD;
  31.  
  32. VAR
  33.              lead,                    (* LeadIn-Worte vor Seriennummern  *)
  34.          expCount,                    (* erwartete Anzahl der Vorkommen  *)
  35.             value: ARRAY [0..NrKeys] OF CARDINAL;
  36.           offsets: ARRAY [0..NrKeys] OF PosList;
  37.  
  38.            RegLen,
  39.          FeedBack,
  40.           Iterate: ARRAY [1..NrKeys] OF CARDINAL;
  41.  
  42.  
  43. PROCEDURE err (s: ARRAY OF CHAR; fatal: BOOLEAN);
  44.   VAR c: CHAR;
  45.   BEGIN
  46.     WriteLn; WriteString ('>> '); WriteString (s); WriteLn;
  47.     IF fatal THEN
  48.       Read (c); TermProcess (1);
  49.     END
  50.   END err;
  51.   
  52.  
  53. PROCEDURE ReadCompiler (VAR a: ADDRESS; VAR size: LONGCARD;
  54.                          name: ARRAY OF CHAR): BOOLEAN;
  55.   
  56.   (* Sucht Datei <name> auf DefaultPath,
  57.      reserviert Speicher und liest Datei ein.
  58.      <a>    := Anfangsadresse der Datei im Speicher;
  59.      <size> := Länge  -"- .
  60.      Ergebnis := 'Datei gefunden, genug Platz zum Einlesen gehabt'
  61.   *)
  62.   
  63.   VAR         f: File;
  64.              ok: BOOLEAN;
  65.            path: PathList;
  66.            read: LONGCARD;
  67.        realname: ARRAY [0..127] OF CHAR;
  68.        
  69.   BEGIN
  70.     path := StdPaths();
  71.     SearchFile (name, path, fromStart, ok, realname);
  72.     IF NOT ok THEN RETURN FALSE END;
  73.     Open (f, realname, readOnly);
  74.     size := FileSize (f);
  75.     ALLOCATE (a, size);
  76.     IF a = NIL THEN RETURN FALSE END;
  77.     ReadBytes (f, a, size, read);
  78.     IF size # read THEN RETURN FALSE END;
  79.     Close (f);
  80.     RETURN TRUE
  81.   END ReadCompiler;
  82.  
  83.  
  84. PROCEDURE Search (        a: ADDRESS; len: LONGCARD; targ1, targ2: CARDINAL;
  85.                   VAR count: CARDINAL;
  86.                     VAR pos: PosList);
  87.   BEGIN
  88.     ASSEMBLER
  89.       MOVE.L   pos(A6),A1
  90.       CLR.W    D3
  91.       MOVE.L   a(A6),A0
  92.       MOVE.L   len(A6),D1
  93.       MOVE.W   targ1(A6),D0
  94.       MOVE.W   targ2(A6),D4
  95.    
  96.    lp CMP.W    (A0)+,D0         ;Suchschleife
  97.       BNE      nix
  98.       CMP.W    (A0),D4
  99.       BNE      nix
  100.       MOVE.L   A0,D2
  101.       SUB.L    a(A6),D2
  102.       MOVE.L   D2,(A1)+
  103.       ADDQ.L   #1,D3
  104.   nix SUBQ.L   #2,D1
  105.       BHI      lp
  106.       
  107.       MOVE.L   count(A6),A0
  108.       MOVE.W   D3,(A0)          ;setze Count
  109.     END
  110.   END Search;
  111.  
  112.  
  113. PROCEDURE encode (start, len, feedback, iter: CARDINAL): CARDINAL; (*$L-*)
  114.     
  115.   (* Schieberegister rechtsrum, Bits 0..<len>,
  116.      Rückkopplung aus Bit <feedback>, auf <start>-Wert loslassen.
  117.      <iter> Iterationen durchführen; Ergebnis auf Cardinal kürzen
  118.   *)
  119.   
  120.   BEGIN
  121.     ASSEMBLER
  122.       MOVE.W  -(A3),D2        ;Iterationen
  123.       MOVE.W  -(A3),D0        ;rückgeführtes Bit
  124.       MOVE.W  -(A3),D4        ;Registerlänge -1
  125.       CLR.L   D1
  126.       MOVE.W  -(A3),D1        ;Startwert
  127.       BRA     l1
  128.    l2 BTST    D0,D1           ;Bit0 := Bit0 EOR Bit(D0)
  129.       BEQ     nochg           ; "
  130.       BCHG    #0,D1           ; "
  131. nochg LSR.L   #1,D1           ;einmal rechts schieben
  132.       BCC     l1              ;und Bit0 in Bit(D4) rotieren
  133.       BSET    D4,D1
  134.    l1 DBF     D2,l2
  135.       MOVE.W  D1,(A3)+        ;Ergebnis zurück
  136.     END
  137.   END encode;         (*$L+*)
  138.   
  139.   
  140. PROCEDURE CalcSer (mySer: CARDINAL);
  141.   
  142.   (* Übergabe der Seriennummer in <mySer>.
  143.      Setzt ARRAY <value> auf verschlüsselte Seriennummern.
  144.      Verwendet Beschreibung der Schlüsselverfahren in
  145.      <RegLen>, <FeedBack>, <Iterate>.           *)
  146.   
  147.   VAR  k: CARDINAL;
  148.   
  149.   BEGIN
  150.     value [0] := mySer;
  151.     WriteString ('   Schlüssel'); WriteHex (value [0], 7);
  152.     FOR k := 1 TO NrKeys DO
  153.       value [k] := encode (mySer, RegLen[k], FeedBack[k], Iterate[k]);
  154.       WriteHex (value[k], 7);
  155.     END;
  156.     WriteLn;
  157.   END CalcSer;
  158.   
  159.   
  160. PROCEDURE Check (mySer: CARDINAL);
  161.   
  162.   (*  Liest Datei <compname> nach Suche auf DefaultPath.
  163.       Durchsucht nach Auftreten von <lead>, <value> und prüft
  164.       jeweils, ob <expcount> Vorkommen gefunden.
  165.       Bricht im Fehlerfall mit Meldung ab.
  166.   *)
  167.       
  168.   VAR   a: ADDRESS;
  169.         l: LONGCARD;
  170.  count, k: CARDINAL;
  171.    errmsg: ARRAY [0..127] OF CHAR;
  172.     dummy: BOOLEAN;
  173.   
  174.   BEGIN
  175.     CalcSer (mySer);
  176.     IF ReadCompiler (a, l, compname) THEN
  177.       FOR k := 0 TO NrKeys DO
  178.         Search (a, l, lead [k], value [k], count, offsets [k]);
  179.         IF count # expCount [k] THEN
  180.           Concat ('Falsche Anzahl Einträge: Schlüssel ',
  181.                    CardToStr (count, 0), errmsg, dummy);
  182.           err (errmsg, FALSE)
  183.         END;
  184.       END
  185.     ELSE
  186.       err ('Compiler kann nicht gelesen werden!', FALSE);
  187.     END;
  188.   END Check;
  189.   
  190.   
  191. VAR   mySer: CARDINAL;
  192.           c: CHAR;
  193.  
  194. BEGIN
  195.   
  196.   (* Konstanten für Schlüssel *)
  197.   
  198.   RegLen [1] := 17; FeedBack [1] := 7; Iterate [1] :=  39;
  199.   RegLen [2] := 16; FeedBack [2] := 3; Iterate [2] := 367;
  200.    
  201.   (* Default-Seriennummern im Compiler *)
  202.   
  203.   expCount [0] := 3;  lead [0] := $0641;
  204.   expCount [1] := 1;  lead [1] := $343C;
  205.   expCount [2] := 1;  lead [2] := $0240;
  206.   
  207.   (* Seriennummern im Compiler suchen *)
  208.   
  209.   WriteString ('CheckSerial /1.0/:  Seriennummern in Compiler prüfen ');
  210.   WriteLn; WriteLn;
  211.   
  212.   
  213.   (* neue Seriennummern eintragen *)
  214.   
  215.   LOOP
  216.     WriteString ('Suchen der Seriennummern:'); WriteLn;
  217.     WriteString ('   '); WriteString (compname);
  218.     WriteString (' auf DefaultPath ?'); WriteLn;
  219.     WriteString ('   Nummer eingeben (0 stoppt): ');
  220.     ReadCard (mySer);
  221.     IF mySer = 0 THEN EXIT END;
  222.     
  223.     Check (mySer);
  224.     WriteString ('   fertig.'); WriteLn; WriteLn;
  225.   
  226.   END;
  227.   
  228. END CheckSerial.
  229. (* $FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$0000197F$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFF7D556$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363A$FFFC363AÇ$00000362T.......T.......T.......T.......T.....T.T.......T.......T.......T.......T.......$00000156$00001978$FFF69E50$00001986$000019B1$FFF69E50$000019A3$00000362$FFF67E33$FFF67E33$FFF67E33$FFF67E33$FFF67E33$FFF67E33$0000160F$00001451áÇü*)
  230.